m <- magicOpen [MagicMime]
liftIO $ getEnv "GIT_ANNEX_DIR" >>= \case
Nothing -> magicLoadDefault m
- Just d -> magicLoad m
- (d </> "magic" </> "magic.mgc")
+ Just d -> magicLoad m $ fromOsPath $
+ toOsPath d
+ </> literalOsPath "magic"
+ </> literalOsPath "magic.mgc"
return m
#else
initMagicMime = return Nothing
module Assistant.Install.AutoStart where
+import Common
import Utility.FreeDesktop
#ifdef darwin_HOST_OS
import Utility.OSX
import Utility.FileSystemEncoding
#endif
-installAutoStart :: FilePath -> FilePath -> IO ()
+installAutoStart :: String -> OsPath -> IO ()
installAutoStart command file = do
#ifdef darwin_HOST_OS
- createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath file)))
- writeFile file $ genOSXAutoStartFile osxAutoStartLabel command
+ createDirectoryIfMissing True (parentDir file)
+ writeFile (fromOsPath file) $ genOSXAutoStartFile osxAutoStartLabel command
["assistant", "--autostart"]
#else
writeDesktopMenuFile (fdoAutostart command) file
module Assistant.Install.Menu where
+import Common
import Utility.FreeDesktop
import Utility.FileSystemEncoding
import Utility.Path
import System.IO
import Utility.SystemDirectory
-#ifndef darwin_HOST_OS
-import System.FilePath
-#endif
-installMenu :: FilePath -> FilePath -> FilePath -> FilePath -> IO ()
+installMenu :: String -> OsPath -> OsPath -> OsPath -> IO ()
#ifdef darwin_HOST_OS
installMenu _command _menufile _iconsrcdir _icondir = return ()
#else
installMenu command menufile iconsrcdir icondir = do
writeDesktopMenuFile (fdoDesktopMenu command) menufile
- installIcon (iconsrcdir </> "logo.svg") $
- iconFilePath (iconBaseName ++ ".svg") "scalable" icondir
- installIcon (iconsrcdir </> "logo_16x16.png") $
- iconFilePath (iconBaseName ++ ".png") "16x16" icondir
+ installIcon (iconsrcdir </> literalOsPath "logo.svg") $
+ iconFilePath (toOsPath (iconBaseName ++ ".svg")) "scalable" icondir
+ installIcon (iconsrcdir </> literalOsPath "logo_16x16.png") $
+ iconFilePath (toOsPath (iconBaseName ++ ".png")) "16x16" icondir
#endif
{- The command can be either just "git-annex", or the full path to use
(Just iconBaseName)
["Network", "FileTransfer"]
-installIcon :: FilePath -> FilePath -> IO ()
+installIcon :: OsPath -> OsPath -> IO ()
installIcon src dest = do
- createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath dest)))
- withBinaryFile src ReadMode $ \hin ->
- withBinaryFile dest WriteMode $ \hout ->
+ createDirectoryIfMissing True (parentDir dest)
+ withBinaryFile (fromOsPath src) ReadMode $ \hin ->
+ withBinaryFile (fromOsPath dest) WriteMode $ \hout ->
hGetContents hin >>= hPutStr hout
iconBaseName :: String
module Build.DesktopFile where
-import Utility.Exception
+import Common
import Utility.FreeDesktop
-import Utility.Path
-import Utility.Monad
-import Utility.SystemDirectory
-import Utility.FileSystemEncoding
import Config.Files
import Utility.OSX
import Assistant.Install.AutoStart
import System.Environment
#ifndef mingw32_HOST_OS
import System.Posix.User
-import Data.Maybe
-import Control.Applicative
import Prelude
#endif
systemwideInstall = return False
#endif
-inDestDir :: FilePath -> IO FilePath
+inDestDir :: OsPath -> IO OsPath
inDestDir f = do
destdir <- catchDefaultIO "" (getEnv "DESTDIR")
- return $ destdir ++ "/" ++ f
+ return $ toOsPath destdir <> literalOsPath "/" <> f
writeFDODesktop :: FilePath -> IO ()
writeFDODesktop command = do
datadir <- if systemwide then return systemDataDir else userDataDir
menufile <- inDestDir (desktopMenuFilePath "git-annex" datadir)
icondir <- inDestDir (iconDir datadir)
- installMenu command menufile "doc" icondir
+ installMenu command menufile (literalOsPath "doc") icondir
configdir <- if systemwide then return systemConfigDir else userConfigDir
installAutoStart command
( return ()
, do
programfile <- inDestDir =<< programFile
- createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath programfile)))
- writeFile programfile command
+ createDirectoryIfMissing True (parentDir programfile)
+ writeFile (fromOsPath programfile) command
)
installUser :: FilePath -> IO ()
module Config.Files where
+import Common
import Utility.FreeDesktop
import Utility.Exception
-import System.FilePath
-
{- ~/.config/git-annex/file -}
-userConfigFile :: FilePath -> IO FilePath
+userConfigFile :: OsPath -> IO OsPath
userConfigFile file = do
- dir <- userConfigDir
- return $ dir </> "git-annex" </> file
+ dir <- toOsPath <$> userConfigDir
+ return $ dir </> literalOsPath "git-annex" </> file
-autoStartFile :: IO FilePath
-autoStartFile = userConfigFile "autostart"
+autoStartFile :: IO OsPath
+autoStartFile = userConfigFile (literalOsPath "autostart")
{- The path to git-annex is written here; which is useful when something
- has installed it to some awful non-PATH location. -}
-programFile :: IO FilePath
-programFile = userConfigFile "program"
+programFile :: IO OsPath
+programFile = userConfigFile (literalOsPath "program")
{- A .noannex file in a git repository prevents git-annex from
- initializing that repository. The content of the file is returned. -}
-noAnnexFileContent :: Maybe FilePath -> IO (Maybe String)
+noAnnexFileContent :: Maybe OsPath -> IO (Maybe String)
noAnnexFileContent repoworktree = case repoworktree of
Nothing -> return Nothing
- Just wt -> catchMaybeIO (readFile (wt </> ".noannex"))
+ Just wt -> catchMaybeIO (readFile (fromOsPath (wt </> literalOsPath ".noannex")))
import Utility.Tmp
{- Returns anything listed in the autostart file (which may not exist). -}
-readAutoStartFile :: IO [FilePath]
+readAutoStartFile :: IO [OsPath]
readAutoStartFile = do
f <- autoStartFile
- filter valid . nub . map dropTrailingPathSeparator . lines
- <$> catchDefaultIO "" (readFile f)
+ filter valid . nub . map (dropTrailingPathSeparator . toOsPath) . lines
+ <$> catchDefaultIO "" (readFile (fromOsPath f))
where
-- Ignore any relative paths; some old buggy versions added eg "."
valid = isAbsolute
-modifyAutoStartFile :: ([FilePath] -> [FilePath]) -> IO ()
+modifyAutoStartFile :: ([OsPath] -> [OsPath]) -> IO ()
modifyAutoStartFile func = do
dirs <- readAutoStartFile
let dirs' = nubBy equalFilePath $ func dirs
when (dirs' /= dirs) $ do
f <- autoStartFile
- createDirectoryIfMissing True $
- fromRawFilePath (parentDir (toRawFilePath f))
+ createDirectoryIfMissing True (parentDir f)
viaTmp (writeFile . fromRawFilePath . fromOsPath)
- (toOsPath (toRawFilePath f))
- (unlines dirs')
+ (toOsPath f)
+ (unlines (map fromOsPath dirs'))
{- Adds a directory to the autostart file. If the directory is already
- present, it's moved to the top, so it will be used as the default
- when opening the webapp. -}
-addAutoStartFile :: FilePath -> IO ()
+addAutoStartFile :: OsPath -> IO ()
addAutoStartFile path = do
- path' <- fromRawFilePath <$> absPath (toRawFilePath path)
+ path' <- absPath path
modifyAutoStartFile $ (:) path'
{- Removes a directory from the autostart file. -}
-removeAutoStartFile :: FilePath -> IO ()
+removeAutoStartFile :: OsPath -> IO ()
removeAutoStartFile path = do
- path' <- fromRawFilePath <$> absPath (toRawFilePath path)
+ path' <- absPath path
modifyAutoStartFile $
filter (not . equalFilePath path')
repoWorkTree _ = Nothing
{- Path to a local repository's .git directory. -}
-localGitDir :: Repo -> RawFilePath
+localGitDir :: Repo -> OsPath
localGitDir Repo { location = Local { gitdir = d } } = d
localGitDir _ = giveup "unknown localGitDir"
{- Path to a given hook script in a repository, only if the hook exists
- and is executable. -}
-hookPath :: String -> Repo -> IO (Maybe FilePath)
+hookPath :: String -> Repo -> IO (Maybe OsPath)
hookPath script repo = do
- let hook = fromRawFilePath (localGitDir repo) </> "hooks" </> script
+ let hook = localGitDir repo </> literalOsPath "hooks" </> toOsPath script
ifM (catchBoolIO $ isexecutable hook)
( return $ Just hook , return Nothing )
where
#if mingw32_HOST_OS
isexecutable f = doesFileExist f
#else
- isexecutable f = isExecutable . fileMode <$> getSymbolicLinkStatus f
+ isexecutable f = isExecutable . fileMode
+ <$> getSymbolicLinkStatus (fromOsPath f)
#endif
{- Makes the path to a local Repo be relative to the cwd. -}
global :: IO (Maybe Repo)
global = do
home <- myHomeDir
- ifM (doesFileExist $ home </> ".gitconfig")
+ ifM (doesFileExist $ toOsPath home </> literalOsPath ".gitconfig")
( Just <$> withCreateProcess p go
, return Nothing
)
-}
updateLocation :: Repo -> IO Repo
updateLocation r@(Repo { location = LocalUnknown d }) = case isBare r of
- Just True -> ifM (doesDirectoryExist (fromRawFilePath dotgit))
+ Just True -> ifM (doesDirectoryExist dotgit)
( updateLocation' r $ Local dotgit Nothing
, updateLocation' r $ Local d Nothing
)
Just False -> mknonbare
{- core.bare not in config, probably because safe.directory
- did not allow reading the config -}
- Nothing -> ifM (Git.Construct.isBareRepo (fromRawFilePath d))
+ Nothing -> ifM (Git.Construct.isBareRepo d)
( mkbare
, mknonbare
)
where
- dotgit = d P.</> ".git"
+ dotgit = d </> literalOsPath ".git"
-- git treats eg ~/foo as a bare git repository located in
-- ~/foo/.git if ~/foo/.git/config has core.bare=true
- mkbare = ifM (doesDirectoryExist (fromRawFilePath dotgit))
+ mkbare = ifM (doesDirectoryExist dotgit)
( updateLocation' r $ Local dotgit Nothing
, updateLocation' r $ Local d Nothing
)
fromRemotePath :: FilePath -> Repo -> IO Repo
fromRemotePath dir repo = do
dir' <- expandTilde dir
- fromPath $ repoPath repo P.</> toRawFilePath dir'
+ fromPath $ repoPath repo P.</> dir'
{- Git remotes can have a directory that is specified relative
- to the user's home directory, or that contains tilde expansions.
- This converts such a directory to an absolute path.
- Note that it has to run on the system where the remote is.
-}
-repoAbsPath :: RawFilePath -> IO RawFilePath
+repoAbsPath :: OsPath -> IO OsPath
repoAbsPath d = do
- d' <- expandTilde (fromRawFilePath d)
+ d' <- expandTilde (fromOsPath d)
h <- myHomeDir
- return $ toRawFilePath $ h </> d'
+ return $ toOsPath h </> d'
-expandTilde :: FilePath -> IO FilePath
+expandTilde :: FilePath -> IO OsPath
#ifdef mingw32_HOST_OS
-expandTilde = return
+expandTilde = return . toOsPath
#else
expandTilde p = expandt True p
-- If unable to expand a tilde, eg due to a user not existing,
-- use the path as given.
- `catchNonAsync` (const (return p))
+ `catchNonAsync` (const (return (toOsPath p)))
where
- expandt _ [] = return ""
+ expandt _ [] = return $ literalOsPath ""
expandt _ ('/':cs) = do
v <- expandt True cs
- return ('/':v)
+ return $ literalOsPath "/" <> v
expandt True ('~':'/':cs) = do
h <- myHomeDir
- return $ h </> cs
- expandt True "~" = myHomeDir
+ return $ toOsPath h </> toOsPath cs
+ expandt True "~" = toOsPath <$> myHomeDir
expandt True ('~':cs) = do
let (name, rest) = findname "" cs
u <- getUserEntryForName name
- return $ homeDirectory u </> rest
+ return $ toOsPath (homeDirectory u) </> toOsPath rest
expandt _ (c:cs) = do
v <- expandt False cs
- return (c:v)
+ return $ toOsPath [c] <> v
findname n [] = (n, "")
findname n (c:cs)
| c == '/' = (n, cs)
{- Checks if a git repository exists in a directory. Does not find
- git repositories in parent directories. -}
-checkForRepo :: RawFilePath -> IO (Maybe RepoLocation)
+checkForRepo :: OsPath -> IO (Maybe RepoLocation)
checkForRepo dir =
check isRepo $
check (checkGitDirFile dir) $
- check (checkdir (isBareRepo dir')) $
+ check (checkdir (isBareRepo dir)) $
return Nothing
where
check test cont = maybe cont (return . Just) =<< test
, return Nothing
)
isRepo = checkdir $
- doesFileExist (dir' </> ".git" </> "config")
+ doesFileExist (dir </> literalOsPath ".git" </> literalOsPath "config")
<||>
-- A git-worktree lacks .git/config, but has .git/gitdir.
-- (Normally the .git is a file, not a symlink, but it can
-- be converted to a symlink and git will still work;
-- this handles that case.)
- doesFileExist (dir' </> ".git" </> "gitdir")
- dir' = fromRawFilePath dir
+ doesFileExist (dir </> literalOsPath ".git" </> literalOsPath "gitdir")
-isBareRepo :: FilePath -> IO Bool
-isBareRepo dir = doesFileExist (dir </> "config")
- <&&> doesDirectoryExist (dir </> "objects")
+isBareRepo :: OsPath -> IO Bool
+isBareRepo dir = doesFileExist (dir </> literalOsPath "config")
+ <&&> doesDirectoryExist (dir </> literalOsPath "objects")
-- Check for a .git file.
-checkGitDirFile :: RawFilePath -> IO (Maybe RepoLocation)
+checkGitDirFile :: OsPath -> IO (Maybe RepoLocation)
checkGitDirFile dir = adjustGitDirFile' $ Local
- { gitdir = dir P.</> ".git"
+ { gitdir = dir </> literalOsPath ".git"
, worktree = Just dir
}
Just d -> do
curr <- R.getCurrentDirectory
unless (d `dirContains` curr) $
- setCurrentDirectory (fromRawFilePath d)
+ setCurrentDirectory d
relPath $ addworktree wt r
where
getpathenv s = do
import Git
import Git.Quote
-import qualified System.FilePath.ByteString as P
-import qualified System.FilePath.Posix.ByteString
import GHC.Generics
import Control.DeepSeq
-{- A RawFilePath, relative to the top of the git repository. -}
-newtype TopFilePath = TopFilePath { getTopFilePath :: RawFilePath }
+{- A path relative to the top of the git repository. -}
+newtype TopFilePath = TopFilePath { getTopFilePath :: OsPath }
deriving (Show, Eq, Ord, Generic)
instance NFData TopFilePath
UnquotedByteString (fromRef' b) <> ":" <> QuotedPath (getTopFilePath f)
{- Path to a TopFilePath, within the provided git repo. -}
-fromTopFilePath :: TopFilePath -> Git.Repo -> RawFilePath
-fromTopFilePath p repo = P.combine (repoPath repo) (getTopFilePath p)
+fromTopFilePath :: TopFilePath -> Git.Repo -> OsPath
+fromTopFilePath p repo = combine (repoPath repo) (getTopFilePath p)
{- The input FilePath can be absolute, or relative to the CWD. -}
-toTopFilePath :: RawFilePath -> Git.Repo -> IO TopFilePath
+toTopFilePath :: OsPath -> Git.Repo -> IO TopFilePath
toTopFilePath file repo = TopFilePath <$> relPathDirToFile (repoPath repo) file
{- The input RawFilePath must already be relative to the top of the git
- repository -}
-asTopFilePath :: RawFilePath -> TopFilePath
+asTopFilePath :: OsPath -> TopFilePath
asTopFilePath file = TopFilePath file
{- Git may use a different representation of a path when storing
- despite Windows using '\'.
-
-}
-type InternalGitPath = RawFilePath
+type InternalGitPath = OsPath
-toInternalGitPath :: RawFilePath -> InternalGitPath
+toInternalGitPath :: OsPath -> InternalGitPath
#ifndef mingw32_HOST_OS
toInternalGitPath = id
#else
-toInternalGitPath = encodeBS . replace "\\" "/" . decodeBS
+toInternalGitPath = toOsPath . encodeBS . replace "\\" "/" . decodeBS . fromOsPath
#endif
-fromInternalGitPath :: InternalGitPath -> RawFilePath
+fromInternalGitPath :: InternalGitPath -> OsPath
#ifndef mingw32_HOST_OS
fromInternalGitPath = id
#else
-fromInternalGitPath = encodeBS . replace "/" "\\" . decodeBS
+fromInternalGitPath = toOsPath . encodeBS . replace "/" "\\" . decodeBS . fromOsPath
#endif
{- isAbsolute on Windows does not think "/foo" or "\foo" is absolute,
- so try posix paths.
-}
absoluteGitPath :: RawFilePath -> Bool
-absoluteGitPath p = P.isAbsolute p ||
- System.FilePath.Posix.ByteString.isAbsolute (toInternalGitPath p)
+absoluteGitPath p = isAbsolute p || isAbsolute (toInternalGitPath p)
{- Injects a blob into git. Unfortunately, the current git-hash-object
- interface does not allow batch hashing without using temp files. -}
hashBlob :: HashableBlob b => HashObjectHandle -> b -> IO Sha
-hashBlob h b = withTmpFile (toOsPath "hash") $ \tmp tmph -> do
+hashBlob h b = withTmpFile (literalOsPath "hash") $ \tmp tmph -> do
hashableBlobToHandle tmph b
hClose tmph
hashFile h (fromOsPath tmp)
- is run with a bundled bash, so should start with #!/bin/sh
-}
hookWrite :: Hook -> Repo -> IO Bool
-hookWrite h r = ifM (doesFileExist (fromRawFilePath f))
+hookWrite h r = ifM (doesFileExist f)
( expectedContent h r >>= \case
UnexpectedContent -> return False
ExpectedContent -> return True
, return True
)
where
- f = fromRawFilePath $ hookFile h r
+ f = hookFile h r
data ExpectedContent = UnexpectedContent | ExpectedContent | OldExpectedContent
{- The file used to record a ref. (Git also stores some refs in a
- packed-refs file.) -}
-file :: Ref -> Repo -> FilePath
-file ref repo = fromRawFilePath (localGitDir repo) </> fromRef ref
+file :: Ref -> Repo -> OsPath
+file ref repo = localGitDir repo </> toOsPath (fromRef' ref)
{- Checks if HEAD exists. It generally will, except for in a repository
- that was just created. -}
, " "
, fromRef s
, "\t"
- , takeFileName (fromRawFilePath (getTopFilePath f))
+ , fromOsPath (takeFileName (getTopFilePath f))
, "\NUL"
]
module Git.Types where
+import Utility.SafeCommand
+import Utility.FileSystemEncoding
+import Utility.OsPath
+
import Network.URI
import Data.String
import Data.Default
import qualified Data.ByteString as S
import qualified Data.List.NonEmpty as NE
import System.Posix.Types
-import Utility.SafeCommand
-import Utility.FileSystemEncoding
import qualified Data.Semigroup as Sem
import Prelude
- else known about it.
-}
data RepoLocation
- = Local { gitdir :: RawFilePath, worktree :: Maybe RawFilePath }
- | LocalUnknown RawFilePath
+ = Local { gitdir :: OsPath, worktree :: Maybe OsPath }
+ | LocalUnknown OsPath
| Url URI
| UnparseableUrl String
| Unknown
userDesktopDir
) where
+import Common
import Utility.Exception
import Utility.UserInfo
import Utility.Process
import System.Environment
-import System.FilePath
-import System.Directory
import Data.List
import Data.Maybe
import Control.Applicative
where
keyvalue (k, v) = k ++ "=" ++ toString v
-writeDesktopMenuFile :: DesktopEntry -> String -> IO ()
+writeDesktopMenuFile :: DesktopEntry -> OsPath -> IO ()
writeDesktopMenuFile d file = do
createDirectoryIfMissing True (takeDirectory file)
- writeFile file $ buildDesktopMenuFile d
+ writeFile (fromOsPath file) $ buildDesktopMenuFile d
{- Path to use for a desktop menu file, in either the systemDataDir or
- the userDataDir -}
-desktopMenuFilePath :: String -> FilePath -> FilePath
+desktopMenuFilePath :: String -> OsPath -> OsPath
desktopMenuFilePath basename datadir =
- datadir </> "applications" </> desktopfile basename
+ datadir </> literalOsPath "applications" </> desktopfile basename
{- Path to use for a desktop autostart file, in either the systemDataDir
- or the userDataDir -}
-autoStartPath :: String -> FilePath -> FilePath
+autoStartPath :: String -> OsPath -> OsPath
autoStartPath basename configdir =
- configdir </> "autostart" </> desktopfile basename
+ configdir </> literalOsPath "autostart" </> desktopfile basename
{- Base directory to install an icon file, in either the systemDataDir
- or the userDatadir. -}
-iconDir :: FilePath -> FilePath
-iconDir datadir = datadir </> "icons" </> "hicolor"
+iconDir :: OsPath -> OsPath
+iconDir datadir = datadir </> literalOsPath "icons" </> literalOsPath "hicolor"
{- Filename of an icon, given the iconDir to use.
-
- The resolution is something like "48x48" or "scalable". -}
-iconFilePath :: FilePath -> String -> FilePath -> FilePath
+iconFilePath :: OsPath -> String -> OsPath -> OsPath
iconFilePath file resolution icondir =
- icondir </> resolution </> "apps" </> file
+ icondir </> toOsPath resolution </> literalOsPath "apps" </> file
-desktopfile :: FilePath -> FilePath
-desktopfile f = f ++ ".desktop"
+desktopfile :: FilePath -> OsPath
+desktopfile f = toOsPath $ f ++ ".desktop"
{- Directory used for installation of system wide data files.. -}
-systemDataDir :: FilePath
-systemDataDir = "/usr/share"
+systemDataDir :: OsPath
+systemDataDir = literalOsPath "/usr/share"
{- Directory used for installation of system wide config files. -}
-systemConfigDir :: FilePath
-systemConfigDir = "/etc/xdg"
+systemConfigDir :: OsPath
+systemConfigDir = literalOsPath "/etc/xdg"
{- Directory for user data files. -}
-userDataDir :: IO FilePath
-userDataDir = xdgEnvHome "DATA_HOME" ".local/share"
+userDataDir :: IO OsPath
+userDataDir = toOsPath <$> xdgEnvHome "DATA_HOME" ".local/share"
{- Directory for user config files. -}
-userConfigDir :: IO FilePath
-userConfigDir = xdgEnvHome "CONFIG_HOME" ".config"
+userConfigDir :: IO OsPath
+userConfigDir = toOsPath <$> xdgEnvHome "CONFIG_HOME" ".config"
{- Directory for the user's Desktop, may be localized.
-
xdgEnvHome :: String -> String -> IO String
xdgEnvHome envbase homedef = do
- home <- myHomeDir
- catchDefaultIO (home </> homedef) $
- getEnv $ "XDG_" ++ envbase
+ home <- toOsPath <$> myHomeDir
+ catchDefaultIO (fromOsPath $ home </> toOsPath homedef) $
+ getEnv ("XDG_" ++ envbase)
genOSXAutoStartFile,
) where
+import Common
import Utility.UserInfo
-import System.FilePath
+autoStartBase :: String -> OsPath
+autoStartBase label = literalOsPath "Library" </> literalOsPath "LaunchAgents" </> literalOsPath (label ++ ".plist")
-autoStartBase :: String -> FilePath
-autoStartBase label = "Library" </> "LaunchAgents" </> label ++ ".plist"
+systemAutoStart :: String -> OsPath
+systemAutoStart label = literalOsPath "/" </> autoStartBase label
-systemAutoStart :: String -> FilePath
-systemAutoStart label = "/" </> autoStartBase label
-
-userAutoStart :: String -> IO FilePath
+userAutoStart :: String -> IO OsPath
userAutoStart label = do
home <- myHomeDir
- return $ home </> autoStartBase label
+ return $ toOsPath home </> autoStartBase label
{- Generates an OSX autostart plist file with a given label, command, and
- params to run at boot or login. -}
import qualified System.OsString
import qualified Data.ByteString as B
import Utility.OsPath
+import Prelude ((.), Int)
{- Avoid System.OsString.length, which returns the number of code points on
- windows. This is the number of bytes. -}
length :: System.OsString.OsString -> Int
-length = B.length . fromOsString
+length = B.length . fromOsPath
#else
import Data.ByteString as X hiding (length)
import Data.ByteString (length)
) where
import qualified Data.ByteString as B
-import qualified System.FilePath.ByteString as PB
import Data.List
import Data.Maybe
import Control.Monad
norm c [] = reverse c
norm c (p:ps)
- | p' == ".." && not (null c) && dropTrailingPathSeparator (c !! 0) /= ".." =
- norm (drop 1 c) ps
- | p' == "." = norm c ps
+ | p' == dotdot && not (null c)
+ && dropTrailingPathSeparator (c !! 0) /= dotdot =
+ norm (drop 1 c) ps
+ | p' == dot = norm c ps
| otherwise = norm (p:c) ps
where
p' = dropTrailingPathSeparator p
upFrom :: OsPath -> Maybe OsPath
upFrom dir
| length dirs < 2 = Nothing
- | otherwise = Just $ joinDrive drive $ toOsPath $
- B.intercalate (B.singleton PB.pathSeparator) $ init dirs
+ | otherwise = Just $ joinDrive drive $
+ OS.intercalate (OS.singleton pathSeparator) $ init dirs
where
-- on Unix, the drive will be "/" when the dir is absolute,
-- otherwise ""
dirContains :: OsPath -> OsPath -> Bool
dirContains a b = a == b
|| a' == b'
- || (a'' `B.isPrefixOf` b' && avoiddotdotb)
- || a' == "." && normalise ("." </> b') == b' && nodotdot b'
+ || (a'' `OS.isPrefixOf` b' && avoiddotdotb)
+ || a' == dot && normalise (dot </> b') == b' && nodotdot b'
|| dotdotcontains
where
a' = norm a
nodotdot p = all (not . isdotdot) (splitPath p)
- isdotdot s = dropTrailingPathSeparator s == ".."
+ isdotdot s = dropTrailingPathSeparator s == dotdot
{- This handles the case where a is ".." or "../.." etc,
- and b is "foo" or "../foo" etc. The rule is that when
- count as dotfiles. -}
dotfile :: OsPath -> Bool
dotfile file
- | f == "." = False
- | f == ".." = False
- | f == "" = False
- | otherwise = "." `OS.isPrefixOf` f || dotfile (takeDirectory file)
+ | f == dot = False
+ | f == dotdot = False
+ | f == literalOsPath "" = False
+ | otherwise = dot `OS.isPrefixOf` f || dotfile (takeDirectory file)
where
f = takeFileName file
common = map fst $ takeWhile same $ zip pfrom pto
same (c,d) = c == d
uncommon = drop numcommon pto
- dotdots = replicate (length pfrom - numcommon) ".."
+ dotdots = replicate (length pfrom - numcommon) dotdot
numcommon = length common
#ifdef mingw32_HOST_OS
normdrive = map toLower
searchPath :: String -> IO (Maybe OsPath)
searchPath command
| isAbsolute command' = copyright $ check command'
- | otherwise = getSearchPath >>= getM indir . map toOsPath
+ | otherwise = getSearchPath >>= getM indir
where
command' = toOsPath command
indir d = check (d </> command')
searchPathContents :: (OsPath -> Bool) -> IO [OsPath]
searchPathContents p =
filterM doesFileExist
- =<< (concat <$> (getSearchPath >>= mapM (go . toOsPath)))
+ =<< (concat <$> (getSearchPath >>= mapM go))
where
go d = map (d </>) . filter p
<$> catchDefaultIO [] (getDirectoryContents d)
+
+dot :: OsPath
+dot = literalOsPath "."
+
+dotdot :: OsPath
+dotdot = literalOsPath ".."
+
relHome,
) where
-import System.FilePath.ByteString
import qualified Data.ByteString as B
import Control.Applicative
import Prelude
prop_dirContains_regressionTest,
) where
-import System.FilePath.ByteString
import qualified Data.ByteString as B
import Data.List
import Data.Maybe
import Control.Applicative
import Prelude
+import Common
import Utility.Path
-import Utility.FileSystemEncoding
import Utility.QuickCheck
prop_upFrom_basics :: TestableFilePath -> Bool
projects / git-annex.git / commitdiff